Geo Location Wise Retail and Online Sale Visualization

Geo-Specific Visualization of Retail and Online Sales

library(ggmap)

Loading required package: ggplot2
Google Maps API Terms of Service: http://developers.google.com/maps/terms.
Please cite ggmap if you use it: see citation('ggmap') for details.

library(ggplot2)
library(zipcode)
data_dc <- read.delim(file='//10.8.8.51/lv0/Move to Box/Mithun/projects/9.BR_US_DS_Project/1.data/BR_disc_sens_geo_data.txt',
                      sep = '|',header = F, col.names = c('customer_key',
'percent_disc_last_12_mth',
'br_net_sales_amt_12_mth',
'flag_employee',
'addr_zip_code',
'resp_disc_percent',
'browse_hit_ind_tot',
'purchased',
'br_online_sales12_mth',
'br_offline_sales_12mth'))
data_dc$br_retail_percent <-  data_dc$br_offline_sales_12mth / data_dc$br_net_sales_amt_12_mth
data_dc$br_online_percent <-  data_dc$br_online_sales12_mth / data_dc$br_net_sales_amt_12_mth
data_dc$br_gross_sales_amt <-  data_dc$br_net_sales_amt_12_mth / (1 - data_dc$percent_disc_last_12_mth)

Plot Data as per PIN code

library(dplyr)

Attaching package: <U+393C><U+3E31>dplyr<U+393C><U+3E32>

The following objects are masked from <U+393C><U+3E31>package:stats<U+393C><U+3E32>:

    filter, lag

The following objects are masked from <U+393C><U+3E31>package:base<U+393C><U+3E32>:

    intersect, setdiff, setequal, union

zip_wise_data <- data_dc[,c("br_offline_sales_12mth","br_online_sales12_mth","br_net_sales_amt_12_mth","br_gross_sales_amt","addr_zip_code")] %>% group_by(addr_zip_code) %>% summarise(br_online_sales12_mth = sum(br_online_sales12_mth,na.rm=T), br_offline_sales_12mth = sum(br_offline_sales_12mth,na.rm=T), br_net_sales_amt_12_mth = sum(br_net_sales_amt_12_mth,na.rm=T), br_gross_sales_amt = sum(br_gross_sales_amt,na.rm=T))
zip_wise_data <- zip_wise_data[zip_wise_data$addr_zip_code!='',]
library(zipcode)
data("zipcode")
data_dc2<- inner_join(data_dc,zipcode,by=c("addr_zip_code"="zip"))

joining factor and character vector, coercing into character vector

library("ggplot2")
zip_wise_data <- left_join(zipcode,zip_wise_data,by=c("zip"="addr_zip_code"))

joining factor and character vector, coercing into character vector

Discount Rate by ZipCode

zip_wise_data$disc_percent <- (1 - zip_wise_data$br_net_sales_amt_12_mth/zip_wise_data$br_gross_sales_amt )
zip_wise_data$disc_percent[is.na(zip_wise_data$disc_percent)] <- 0
zip_wise_data$disc_percent[zip_wise_data$disc_percent > 1] <- 1
zip_wise_data$disc_percent[zip_wise_data$disc_percent < 0] <- 0
zip_wise_data$Online_percent<-zip_wise_data$br_online_sales12_mth/zip_wise_data$br_net_sales_amt_12_mth
zip_wise_data$Online_percent[is.na(zip_wise_data$Online_percent)] <- 0
zip_wise_data$Online_percent[zip_wise_data$Online_percent > 1] <- 1
zip_wise_data$Online_percent[zip_wise_data$Online_percent < 0] <- 0
zip_wise_data$binx <- cut(zip_wise_data$disc_percent,breaks = c(-Inf,0,0.20,0.35,0.40,Inf),include.lowest = T,
                          labels = c("No_Info","a_Low","b_Medium","c_High","d_VeryHigh"))
zip_wise_data <-zip_wise_data[which(zip_wise_data$latitude < 50 & zip_wise_data$latitude > 25 &
                                    zip_wise_data$longitude > -125 &  zip_wise_data$longitude < -66),]
ggplot(data=zip_wise_data) + geom_point(aes(x=longitude, y=latitude, colour=binx)) +ggtitle(" Discount Rate  ZIPCODE wise") +theme(legend.position ="bottom")

ggplot(zip_wise_data, aes(x = longitude, y = latitude,  fill= disc_percent )) + geom_polygon(colour = "white", size = 0.1) + theme(legend.position ="bottom")

ggplot(zip_wise_data, aes(x = longitude, y = latitude,  fill= Online_percent )) + geom_polygon(colour = "white", size = 0.1) + theme(legend.position ="bottom")

Discount Bin 10 is highest Discount

require(ggplot2)
require(maptools)
mapcounties <- map_data("county")
mapstates <- map_data("state")

counties <- map('county', fill=TRUE, col="transparent", plot=FALSE)
IDs <- sapply(strsplit(counties$names, ":"), function(x) x[1])
counties_sp <- map2SpatialPolygons(counties, IDs=IDs,
                                   proj4string=CRS("+proj=longlat +datum=WGS84"))

pointsSP <- SpatialPoints(as.data.frame(zip_wise_data[,c('longitude','latitude')]),
proj4string=CRS("+proj=longlat +datum=WGS84"))
indices <- over(pointsSP, counties_sp)

countyNames <- sapply(counties_sp@polygons, function(x) x@ID)

zip_wise_data$county<-countyNames[indices]
# Generate Comma Separated County/Subregion list for all Counties of US
#
mapcounties$county <- with(mapcounties , paste(region, subregion, sep = ","))

# Aggregate our data at County Level (it was earlier aggreated at zipcode level)
#
zip_wise_data.sum<- zip_wise_data %>% group_by(county) %>%  summarize(br_online_sales12_mth = sum(br_online_sales12_mth,na.rm=T), br_offline_sales_12mth = sum(br_offline_sales_12mth,na.rm=T), br_net_sales_amt_12_mth = sum(br_net_sales_amt_12_mth,na.rm=T), br_gross_sales_amt = sum(br_gross_sales_amt,na.rm=T),disc_percent=median(disc_percent,na.rm=T),Online_percent=median(Online_percent))


# Remove any duplicate records
#
zip_wise_data.un<-zip_wise_data.sum[!duplicated(zip_wise_data[c("county")]),]

zip_wise_data.final=merge(zip_wise_data.sum,zip_wise_data.un,by.x='county',by.y = 'county')

zip_wise_data.final$disc_perc_bin <- as.factor(ntile(zip_wise_data.final$disc_percent.x,5))
# Merge our data with all US counties data
#
zip_wise_data.final$Online_percent_bin <- as.factor(ntile(zip_wise_data.final$Online_percent.x,5))
mergedata <- merge(mapcounties, zip_wise_data.final, by.x = "county", by.y = "county")

High Discount Rate County Wise

High Online Sale Percent County Wise

Statewide map

zip_wise_data_state <- inner_join(st_code_file,zip_wise_data_state,by=c("state_code"="state"))

joining factor and character vector, coercing into character vector

Discount and % of Online Sales Visualization by State

% Online Sales by State

Discount Percent taken accross United States

Online Sale Percent over overall sales accross United States